Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/redtop/saver.frm

Text File | 1994-11-27 | 7KB | 239 lines

VERSION 2.00
Begin Form frmSaver
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ClientHeight    =   2940
   ClientLeft      =   285
   ClientTop       =   3150
   ClientWidth     =   6990
   ControlBox      =   0   'False
   Height          =   3345
   Icon            =   SAVER.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   225
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2940
   ScaleWidth      =   6990
   Top             =   2805
   Width           =   7110
   Begin PictureClip pclRedTop
      Cols            =   6
      Location        =   "5940,2745,60,960"
      Picture         =   SAVER.FRX:0302
      Rows            =   3
   End
   Begin Image imgRedTop
      Height          =   855
      Left            =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   915
   End
End
Option Explicit
Dim FirstTime As Integer
Dim PicIndex As Integer

Dim y1 As Integer
Dim x1 As Integer

Dim incY1 As Integer
Dim incX1 As Integer

Dim picWidth As Integer
Dim picHeight As Integer

Dim LastX As Integer
Dim LastY As Integer

'
' Invoked upon an event that could end the screen saver
' ie. KeyDown, MouseDown, MouseMove
'
Sub EndScreenSaver ()

Dim i As Integer

    On Error GoTo Fred
    frmSaver.Enabled = False
    Call ShowMouse

    If PWprotected Then
        ' Load up the password form
        ValidPassword = False
        frmEnterPass.Show 1
        ' Decide what to do
        Select Case ValidPassword
            Case 1 ' Valid
                End
            Case 2 ' Canceled
                ' Reset this form to be TopMost
                SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3
                ' Set the Form to be System Modal (Ouch!)
                i = SetSysModalWindow(hWnd)
                Call HideMouse
                frmSaver.Enabled = True
                Exit Sub
            Case 3 ' Invalid
                frmError.Show 1
                ' Reset this form to be TopMost
                SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3
                ' Set the Form to be System Modal (Ouch!)
                i = SetSysModalWindow(hWnd)
                Call HideMouse
                frmSaver.Enabled = True
                Exit Sub
        End Select
    End If
    ' if not password protected then stop the Screen Saver
    End
Fred:
    frmSaver.Enabled = True
    ' Reset this form to be TopMost
    SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3
    ' Set the Form to be System Modal (Ouch!)
    i = SetSysModalWindow(hWnd)
    Call HideMouse
    Exit Sub

End Sub

Sub Form_Activate ()

    ' The first time the form is activated after it has loaded
    If FirstTime Then
        FirstTime = False
        ' Call the Screen Saver Initialization routine
        Call InitRedTop
        ' Call the Main Screen Saver Loop
        Call RedTop
    End If

End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)

    ' If any key is pressed then
    ' Set coords to 0 so as not to catch a
    ' mouse move over the password form
    LastX = 0
    LastY = 0
    EndScreenSaver

End Sub

Sub Form_Load ()

Dim i As Integer

    FirstTime = True
    'Maximize the Window (Which is all black) - It is a screen saver after all!
    WindowState = 2
    ' Set the form to be TopMost
    SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3
    ' Set the Form to be System Modal (Ouch!)
    i = SetSysModalWindow(hWnd)

End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' If either mouse Button is pressed then
    ' Set coords to 0 so as not to catch a
    ' mouse move over the password form
    LastX = 0
    LastY = 0
    EndScreenSaver

End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' Only Check for mouse move is the user has
    ' asked for this check in the Setup form.

    If MouseMove = 0 Then
        If LastX = 0 Or LastY = 0 Then
            ' first time round or return from EndScreenSaver
            LastX = X
            LastY = Y
        End If
        ' If This position is not near the last position recorded
        If Abs(LastX - X) > 2 * Screen.TwipsPerPixelX Or Abs(LastY - Y) > 2 * Screen.TwipsPerPixelY Then
            ' Set coords to 0 so as not to catch a
            ' mouse move over the password form
            LastX = 0
            LastY = 0
            EndScreenSaver
        Else
            ' Remember the position for the next MouseMove event
            LastX = X
            LastY = Y
        End If
    End If

End Sub

'
' Initialize the Screen Saver
'
Sub InitRedTop ()

        ' Set the First Graphic from the PicClip
        PicIndex = 0
        imgRedTop.Picture = pclRedTop.GraphicCell(PicIndex)
        ' Set the width & height of the picture box
        picWidth = 66 * Screen.TwipsPerPixelX
        picHeight = 61 * Screen.TwipsPerPixelY
        ' Set the Start coordinates
        x1 = 0
        y1 = 0
        ' Set the increments in both x and y directions
        incX1 = 25
        incY1 = 20
        ' Make the image visible
        imgRedTop.Visible = True

End Sub

'
' The Screen Saver Main Loop
'
' This loop only ends on the termination of the Screen Saver
'
Sub RedTop ()

Dim i As Integer

    While True ' forever!
        ' Get next image from PicClip
        PicIndex = PicIndex + 1
        If PicIndex = 18 Then PicIndex = 0
        imgRedTop.Picture = pclRedTop.GraphicCell(PicIndex)
        ' Get next position
        y1 = y1 + incY1
        x1 = x1 + incX1
        ' Check for edges of screen and if necessary change direction
        If y1 >= Screen.Height - picHeight Or y1 <= 0 Then
            incY1 = -1 * incY1
        End If
        If x1 >= Screen.Width - picWidth Or x1 <= 0 Then
            incX1 = -1 * incX1
        End If
        ' move the image
        imgRedTop.Move x1, y1
        ' Make sure everything is painted properly
        DoEvents
        ' a rather crude way of slowing the display down
        ' without impacting on the system as a whole
        For i = 0 To (500 - SpinSpeed)
            DoEvents
        Next i
    Wend

End Sub